home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / base64.tcl.z / base64.tcl
Text File  |  2002-07-08  |  1KB  |  63 lines

  1. # Emit base64 encoding for a string
  2. set i 0
  3. foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
  4.           a b c d e f g h i j k l m n o p q r s t u v w x y z \
  5.           0 1 2 3 4 5 6 7 8 9 + /} {
  6.     set base64($char) $i
  7.     set base64_en($i) $char
  8.     incr i
  9. }
  10.  
  11. proc Base64_Encode {string} {
  12.     global base64_en
  13.     set result {}
  14.     set state 0
  15.     set length 0
  16.     foreach {c} [split $string {}] {
  17.     scan $c %c x
  18.     switch [incr state] {
  19.         1 {    append result $base64_en([expr {($x >>2) & 0x3F}]) }
  20.         2 { append result $base64_en([expr {(($old << 4) & 0x30) | (($x >> 4) & 0xF)}]) }
  21.         3 { append result $base64_en([expr {(($old << 2) & 0x3C) | (($x >> 6) & 0x3)}])
  22.         append result $base64_en([expr {($x & 0x3F)}])
  23.         set state 0}
  24.     }
  25.     set old $x
  26.     incr length
  27.     if {$length >= 72} {
  28.         append result \n
  29.         set length 0
  30.     }
  31.     }
  32.     set x 0
  33.     switch $state {
  34.     0 { # OK }
  35.     1 { append result $base64_en([expr {(($old << 4) & 0x30)}])== }
  36.     2 { append result $base64_en([expr {(($old << 2) & 0x3C)}])=               }
  37.     }
  38.     return $result
  39. }
  40. proc Base64_Decode {string} {
  41.     global base64
  42.  
  43.     set output {}
  44.     set group 0
  45.     set j 18
  46.     foreach char [split $string {}] {
  47.     if [string compare $char "="] {
  48.         set bits $base64($char)
  49.         set group [expr {$group | ($bits << $j)}]
  50.     }
  51.  
  52.     if {[incr j -6] < 0} {
  53.         scan [format %06x $group]] %2x%2x%2x a b c
  54.         append output [format %c%c%c $a $b $c]
  55.         set group 0
  56.         set j 18
  57.     }
  58.     }
  59.     return $output
  60. }
  61.  
  62.  
  63.